home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
BUSINESS
/
XLMATH22.ZIP
/
SOURCE.ZIP
/
XLMATH.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-04-19
|
21KB
|
851 lines
/*----------------------------------------------------------------------*\
XLMATH
========
Copyright 1992 by Roy Kari
Author: Roy Kari
Dept. of Chemistry
Laurentian University
Sudbury, Ont.
Canada P3E 2C6
(705) 675-1151
Internet: "ROY@NICKEL.LAURENTIAN.CA"
Revision history:
1.0 September, 1992
initial version
2.0 January, 1993
added dialog boxes
2.1 April, 1993
bug fixes
This module contains routines written to interface normal C
routines to an Excel custom function format. All custom
functions are assumed to pass a floating point array to the custom
function, and the custom function returns an XLOPER, usually an
array. If you wish to use a dialog box, then the dialog routine
is written to interface the custom function to a dialog box.
The dialog interface must get the input from the Excel sheet,
change it to a floating point array, and then call the custom function.
On return from the custom function, the dialog interface must
display the return XLOPER in the sheet, and free all allocated
memory.
2nd thoughts;
If I had this to over again, I would make the custom functions
accept their input in the form of XLOPER's rather than a
floating point array. This would eliminate the need to convert.
\*----------------------------------------------------------------------*/
/* --------------------------< Include files >--------------------- */
#include <windows.h>
#include <xlcall.h>
#include <float.h>
#include <math.h>
#include <stdlib.h>
#include <framewrk.h>
#include "xlmath.h"
#include "xlutil.h"
#include "xlcurve.h"
#include "xlmcfit.h"
REALTYPE predict (int k, PARVEC p, REALTYPE xk);
/********************************************************************
Diagonalize()
=============
Diagonalize a real symmetric matrix. Eigenvalues are returned
*******************************************************************/
LPXLOPER PASCAL FAR __export Diagonalize(LPFP lpHmat)
{
LPMULTI lpMulti = NULL; // return XLOPER's
LPLPREAL lplpHmat; // pointers for EXCEL allocated array
LPREAL lpEivec; // eigenvector array
LPLPREAL lplpEivec; // pointers for above
LPREAL lpEival; // eigenvalue array
WORD i,j,wRowIndex; // index
int nIter; // no iterations in _Diagonalize()
WORD wRows, wCols; // saves typing
BOOL Success = TRUE;
wRows = lpHmat->wRows;
wCols = lpHmat->wCols;
// error if not square array
if (wRows != wCols)
{
ErrorHandler(XLM_NOT_SQUARE);
return (glpxlError);
}
// allocate a Global 2-D array for eigenvectors. This array allocation
// demonstrates the use of 2-D array indexing M[i][j]. It is
// required in this case because the working routine _Diagonalize() was
// written in this manner and it was too much work to convert
// it to anything else.
if ((lpEivec = (LPREAL)GetMem( sizeof(double)*wRows*wCols)) == NULL)
{
return (glpxlError);
}
if ((lplpEivec = InitPointers(lpEivec, wRows, wCols)) == NULL)
{
Success = FALSE;
goto Error3; // free lpEivec
}
// create pointers for Hmat; array allocated in Excel
if ((lplpHmat = InitPointers(&lpHmat->Data[0], wRows, wRows))
== NULL)
{
Success = FALSE;
goto Error2; // free lpEivec & lplpEivec
}
// allocate a Global 1-D array for eigenvalues
if ((lpEival = (LPREAL)GetMem( sizeof(double)*wRows )) == NULL)
{
Success = FALSE;
goto Error1; // free lpEivec, lplpEivec & lplpHmat
}
// diagonalize the matrix
nIter = _Diagonalize(lplpHmat, lplpEivec, lpEival, wRows);
//
// return vales to EXCEL
//
// init MULTI 1 row larger to store eigenvalues in last row
if ((lpMulti =InitMulti(wRows+1, wRows, xltypeNum)) == NULL)
{
Success = FALSE;
}
else
{
// copy the eigenvectors
for (i = 0; i < wRows; i++)
{
wRowIndex = i*wCols;
for (j=0; j < wCols; j++)
{
lpMulti->Data[wRowIndex+j].val.num = lplpEivec[i][j];
}
}
// copy the eigenvalues
wRowIndex = wRows*wCols;
for (j = 0; j < wCols; j++)
{
lpMulti->Data[wRowIndex+j].val.num = lpEival[j];
}
}
// free pointers and arrays
FreeMem((LPVOID)lpEival);
Error1:
MemFreePtr((LPVOID)lplpHmat);
Error2:
MemFreePtr((LPVOID)lplpEivec);
Error3:
FreeMem((LPVOID)lpEivec);
if (!Success)
{
return (glpxlError);
}
// return XLOPER to EXCEL
return ( (LPXLOPER)lpMulti);
}
/********************************************************************
MODensity()
=============
Compute the MO density as C(T)xOxC
*******************************************************************/
LPXLOPER FAR PASCAL __export MODensity(LPFP lpEivec, LPFP lpOcc)
{
LPMULTI lpDen = NULL;
UINT i, j, k;
UINT i_Idx, j_Idx, ij_Idx, NumVec;
BOOL bError = FALSE;
NumVec = lpEivec->wRows;
if (lpOcc->wRows == 1)
{
// Occ is row vector (1xN)
if (lpOcc->wCols != NumVec)
{
bError = TRUE;
}
}
else
{
// Occ is a column vector (Nx1)
if ( (lpOcc->wRows != NumVec) || (lpOcc->wCols != 1) )
{
bError = TRUE;
}
}
if (bError)
{
ErrorHandler(XLM_MODENSITY);
return (glpxlError);
}
if ((lpDen =InitMulti(NumVec, NumVec, xltypeNum)) == NULL)
{
return (glpxlError);
}
i_Idx = 0;
for (i = 0; i < NumVec; i++)
{
j_Idx = 0;
for (j = 0; j < NumVec; j++)
{
ij_Idx = i_Idx+j;
lpDen->Data[ij_Idx].val.num = 0.0;
for (k = 0; k < NumVec; k++)
{
// den[i][j] = Eivec[i][k]*Eivec[j][k]*Occ[k]
lpDen->Data[ij_Idx].val.num += lpEivec->Data[i_Idx+k] *
lpEivec->Data[j_Idx+k] *
lpOcc->Data[k];
}
j_Idx += NumVec;
}
i_Idx += NumVec;
}
return ((LPXLOPER)lpDen);
}
/********************************************************************
PolyCurveFit()
=============
This function is a generalized least squares curve fitting function.
It fits a polynomial with linear coefficients to a dependent -
independent variable set of data
*******************************************************************/
LPXLOPER PASCAL FAR _export PolyCurveFit(LPFP lpIndVar, LPFP lpDepVar,
unsigned int Order)
{
#define nCols 3 // placed in a NumObs x nCols array
LPMULTI lpMulti;
LPREAL lpYest, lpResid, lpPolycoef, lpCoefsig;
static double See, Rsqrval, Rval, dferror;
static WORD wNumObs;
WORD wRows = lpIndVar->wRows;
WORD wCols = lpIndVar->wCols;
WORD wMinRows = 2*(Order+1) + 4; // needed for return values
BOOL Success = TRUE;
BOOL bColumnVector = TRUE;
WORD i, wRow1, wRow2, wRowIndex;
wNumObs = wRows;
if (wCols > wRows)
{
// change to row vectors
bColumnVector = FALSE;
wNumObs = wCols;
}
// check input dimensions so both same
if ( (lpDepVar->wRows != lpIndVar->wRows) ||
(lpDepVar->wCols != lpIndVar->wCols) ||
(Order >= wNumObs - 1)
)
{
ErrorHandler(XLM_POLY);
return(glpxlError);
}
if (wMinRows < wNumObs)
wMinRows = wNumObs;
// memory for estimated Y values
lpYest = (LPREAL)GetMem( wNumObs*sizeof(double));
if (lpYest == NULL)
{
Success = FALSE;
goto Error4;
}
// memory for residuals
if ((lpResid = (LPREAL)GetMem( wNumObs*sizeof(double))) == NULL)
{
Success = FALSE;
goto Error3;
}
//memory for coefficients of fitted polynomial
if ((lpPolycoef = (LPREAL)GetMem( (Order+1)*sizeof(double))) == NULL)
{
Success = FALSE;
goto Error2;
}
// memory for standard errors of coefficient estimates
if ((lpCoefsig = (LPREAL)GetMem( (Order+1)*sizeof(double))) == NULL)
{
Success = FALSE;
goto Error1;
}
Success = _PolyCurveFit((LPREAL)&lpIndVar->Data[0],
(LPREAL)&lpDepVar->Data[0], (int)wNumObs, (int)Order, lpPolycoef,
lpYest, lpResid, (NPREAL)&See, lpCoefsig, &Rsqrval, &Rval, &dferror);
if (!Success)
goto Error0;
// init XLOPER
if (bColumnVector)
lpMulti = InitMulti(wMinRows, nCols, xltypeNum);
else
lpMulti = InitMulti(nCols, wMinRows, xltypeNum);
if (lpMulti==NULL)
{
Success = FALSE;
goto Error0;
}
// stuff return data into Multi
if (bColumnVector)